CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/program/tjgold.zip/INSTALL.001/GOLDHARD.PAS

Pascal/Delphi Source File | 1995-07-12 | 31KB | 1,186 lines

{--------------------------------------------------------------------------}
{                Product: TechnoJock's Turbo Toolkit                       }
{                Version: GOLD                                             }
{                Build:   1.01                                             }
{                                                                          }
{                Copyright 1986-1995  TechnoJock Software, Inc.            }
{                           All Rights Reserved                            }
{                          Restricted by License                           }
{--------------------------------------------------------------------------}

                    {**********************************}
                    {**       Unit:   GOLDHARD       **}
                    {**********************************}

{++++++++++++++++++++++++++++++} unit GOLDHARD; {++++++++++++++++++++++++++++}

{$I GOLDFLAG.INC}
{$IFNDEF GOLDHARD}
   {$DEFINE GOLDHARD}
{$ENDIF}

{++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}

uses DOS, CRT, GoldStr, GoldAttr;

const
   FingerPrint: string[8] = 'EMMXXXX0';
   Ignore:byte  = 255;         {background attribute}

type
   ErrMsgFunc = function (Ecode:integer):string;

   gVideo = (UnKnown, Mono, CGA, MCGAMono, MCGACol, EGAMono, EGACol, VGAMono, VGACol);
   OSDate = (USA,Europe,Japan);
   LabelStatus = ( CorrectLabel, NoLabel, IncorrectLabel );
   Str12 = string[12];

   tExFCB = record
     FF: byte;           { Signals DOS that this is an ExFCB, must be $FF }
     Reserved0: array[1..5] OF byte;    { Reserved By DOS, must be Zero's }
     Attribute: byte;                   { Same meaning as directory entry }
     DriveID: byte;                     { 0=default, 1=A, 2=B, etc }
     Filename: array[1..8] OF char;  { Left justified, padded with blanks }
     Extension: array[1..3] OF char; { Left justified, padded with blanks }
     CurBlock: word;                 { The current block number }
     RecSize: word;                  { Default of 128 bytes }
     FileSize: longint;
     Date: word;                     { Date created/updated }
     Time: word;                     { Time created/updated }
     Reserved: array[1..8] OF byte;
     CurRec: byte;                   { The current record number }
     Relative: longint;              { Random record number }
   end;

   pMediaInfo = ^MediaInfo;
   MediaInfo = record
     InfoLevel: word;
     SerialNumber: longint;
     VolLabel: Array [ 1..11 ] of byte;
     FatType: Array [ 1..8 ] of byte;
   end;

   HWDataRecPtr = ^HardwareRec;
   HardwareRec = record
      {hardware data}
      DiskInfo: SearchRec;
      ThePathStr: PathStr;
      MediaRec: MediaInfo;
      MediaPointer: pMediaInfo;
      pTheCurrentPath: pointer;
      vExFCB: tExFCB;
   end; { HardwareRec }

   DOSDataRecPtr = ^DOSDataRec;
   DOSDataRec = record
      {DOS Data}
      IDPtr: pointer;
      ROMPtr: pointer;
      vMainInfo: word;
      vComputerID: byte;
      vRomDate: string[8];
   end; { DOSDataRec }

   MemDataRecPtr = ^MemDataRec;
   MemDataRec = record
      {memory data}
      Regs: registers;
      ID: string[8];
      vMemInfo: word;
      vXMSInstalled,
      vEMMInstalled: boolean;
      vEMMMajor: byte;
      vEMMMinor: byte;
   end; { MemDataRec }

   OSDataRecPtr = ^OSDataRec;
   OSDataRec = record
      {OS Data}
      CountryBuf: array[0..$21] of byte;
      Country:word;
      vMajor: byte;
      vMinor: byte;
      vCountry: word;
      vDateFmt: OSDate;
      vCurrency: string[5];
      vThousands: byte;
      vDecimal: byte;
      vDateSeparator: byte;
      vTimeSeparator: byte;
      vTimeFmt: byte;
      vCurrencyFmt: byte;
      vCurrencyDecPlaces: byte;
   end; { OSDataRec }

   HardSet = record
      ECode: integer;
      {screen data}
      Width: byte;               {how wide is screen}
      Depth: byte;               {how many lines}
      ScreenPtr: pointer;        {memory location of screen data}
      DisplayType: gVideo;       {video display type}
      ColorSystem: boolean;      {does video support color}
      ForceBW: boolean;          {use BW color schemes}
      {Misc}
      Regs: registers;
      AnimateDelay: integer;
      EMsgFunc: ErrMsgFunc;
   end;

var
   HardVars: HardSet;

function  LastHardError: integer;
function  GetDispMode: byte;
function  OSVersion(Major:boolean): byte;
function  OSVersionStr: string;
function  ColorScreen: boolean;
function  ComputerID: byte;
function  ParallelPorts: byte;
function  SerialPorts: byte;
function  FloppyDrives: byte;
function  ROMDate: string;
function  GameAdapter: boolean;
function  SerialPrinter: boolean;
function  MathChip: boolean;
function  BaseMemory: integer;
function  EMMInstalled: boolean;
function  XMSInstalled: boolean;
function  EMMVersionMajor: byte;
function  EMMVersionMinor: byte;
function  EMMVersion: string;
function  OSVersionMajor: byte;
function  OSVersionMinor: byte;
function  Country: word;
function  Currency: string;
function  DateFmt: OSDate;
function  ThousandsSep: char;
function  DecimalSep: char;
function  DateSep: char;
function  TimeSep: char;
function  TimeFmt: byte;
function  CurrencyFmt: byte;
function  CurrencyDecPlaces: byte;
{hardware info}
procedure ShowRegs; { for trouble shooting only }
function  LastDrv: integer;
function  LogicalDriveNum( Drive: char ): byte;
function  PhysicalDriveNum( Drive: char ): byte;
function  DriveChar( Drive: byte ): char;
function  GetMediaSerialNumber( Drive: byte ): string;
function  SetMediaSerialNumber( Drive: byte;Serial: longint ): boolean;
function  MediaIsLabeled( Drive: byte ): boolean;
function  DeleteVolumeLabel( Drive: byte ): byte;
function  SetVolumeLabel( Drive: byte; LabelStr: Str12 ): byte;
function  GetVolumeLabel( Drive: byte ): string;
function  LabelIsCorrect( Drive: byte; LabelName: string ): LabelStatus;
function  IsPhantom: boolean;
function  DriveExists(Drive: char): boolean;
function  DriveIsReady( Drive: byte ): boolean;
procedure SetDriveTo( Drive: byte );
function  CurrentDriveByte: byte;
function  CurrentDriveChar: char;
procedure SetCurrentDriveTo( NewDrive: char );
function  CurrentPathStr: DirStr;
function  SetCurrentPath( NewPath: PathStr ): boolean;
function  ValidPath( Path: PathStr ): boolean;

{+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}

function LastHardError: integer;
{}
begin
   LastHardError := HardVars.ECode;
end; { LastHardError }

procedure GetOSData(var OSData:OSDataRec);
{}
var P: byte;
begin
   with HardVars do
   begin
      with regs do
      begin
         with OSData do
         begin
            Ah := $30;
            msdos(Regs);
            vMajor := Al;
            vMinor := Ah;
            AX := $3800;
            DS := seg(CountryBuf);
            DX := ofs(CountryBuf);
            intr($21,Regs);
            vCountry := Regs.BX;
            if vMajor >= 3 then
            begin
               vDateFmt := OSDate(vCountry);
               vCurrency := '     ';
               move(CountryBuf[$2],vCurrency[1],5);
               P := pos(#0,vCurrency);      {ASCIIZ string form}
               if P > 0 then
                  delete(vCurrency,P,5);
               vThousands := CountryBuf[$7];
               vDecimal := CountryBuf[$9];
               vDateSeparator := CountryBuf[$B];
               vTimeSeparator := CountryBuf[$D];
               vTimeFmt := CountryBuf[$11];
               vCurrencyFmt := CountryBuf[$F];
               vCurrencyDecPlaces := CountryBuf[$10];
            end else
            begin
               vDateFmt := OSDate(vCountry);
               vCurrency := chr(CountryBuf[$2]);
               vThousands := CountryBuf[$04];
               vDecimal := CountryBuf[$06];
               vDateSeparator := ord('/');   {not avialable before DOS 3}
               vTimeSeparator := ord(':');
               vTimeFmt := 1;
               vCurrencyFmt := 0;
               vCurrencyDecPlaces := 2;
            end;
         end;
      end;
   end;
end; { GetOSData }

procedure GetDOSData(var DosData:DosDataRec);
{}
begin
   with HardVars do
   begin
      with DOSData do
      begin
         {$IFDEF DPMI}
            vComputerID := 0;
            vRomdate := 'Unknown';
         {$ELSE}
            IDPtr := ptr($F000,$FFFE);
            vComputerID := byte(IDPtr^);
            ROMPtr := ptr($F000,$FFF5);
            move(ROMPtr^,vROMDate[1],8);
            vROMDate[0] := chr(8);
            intr($11,Regs);
            vMainInfo := Regs.AX;
         {$ENDIF}
      end;
   end;
end; { GetDOSData }

procedure GetMemData(var MemData:MemDataRec);
{}
begin
   {memory}
   with HardVars do
   begin
      with MemData do
      begin
         regs.AX := $4300;
         intr($2F,regs);
         vXMSInstalled := (regs.al = $80); {himem.sys}
         {$IFDEF DPMI}
            vEMMInstalled := false;
         {$ELSE}
            intr($12,Regs);
            vMemInfo := Regs.AX;
            with regs do
            begin
               Ah := $35;
               Al := $67;
               Intr($21,Regs); {ES now points to int $67 segment -- id is 10 bytes on}
               move(mem[ES:$000A],ID[1],8);
               ID[0] := chr(8);
               vEMMInstalled := (MemData.ID = FingerPrint);
            end;
         {$ENDIF}
            vEMMMajor := 0;
            vEMMMinor := 0;
            if vEMMInstalled then
            begin
               {get driver version number}
               Regs.Ah := $46;
               intr($67,Regs);
               if Regs.Ah = 0 then
               begin
                  vEMMMajor := Regs.Al shr 4;
                  vEMMMinor := Regs.AL and $F;
               end;
            end;
      end;
   end;
end; { GetMemData }

procedure GetHWData(var HWData:HardWareRec);
{}
begin
   with HardVars do
   begin
      with HWData.MediaRec Do
      begin
         InfoLevel := 0;
         Fillchar(SerialNumber,SizeOf(SerialNumber),#0);
         Fillchar(VolLabel,SizeOf(VolLabel),#0);
         Fillchar(FatType,SizeOf(FatType),#0);
      end;
      HWData.MediaPointer := @HWData.MediaRec;
      with HWData.vExFCB Do
      begin
         FF := $FF;
         Fillchar(Reserved0,SizeOf(Reserved0),0);
         Attribute := VolumeID;
         DriveID := 1; { Default of 'A' }
         Fillchar(Filename,SizeOf(Filename),' ');
         Fillchar(Extension,SizeOf(Extension),' ');
         CurBlock := 0;
         RecSize := 0;
         FileSize := 0;
         Date := 0;
         Time := 0;
         Fillchar(Reserved,SizeOf(Reserved),0);
         CurRec := 0;
         Relative := 0;
      end
   end;
end; { GetHWData }

function TestVideo: gVideo;
{}
var
   Regs: Registers;
   Equip: byte;
   Temp: gVideo;
begin
   with Regs do
   begin
      Al := $00;
      Ah := $1A;   {get VGA info}
      Intr($10,Regs);
      if Al = $1A then
         case Bl of
            $00: Temp := unknown;
            $01: Temp := Mono;
            $04: Temp := EGACol;
            $05: Temp := EGAMono;
            $07: Temp := VGAMono;
            $08: Temp := VGACol;
            $0A,
            $0C: Temp := MCGACol;
            $0B: Temp := MCGAMono;
         else
            Temp := CGA;
         end {case}
      else         {more checking needed}
      begin
         Ah := $12;
         BX := $10;  {get EGA data}
         Intr($10,Regs);
         if BX = $10 then {EGA or Mono}
         begin
            Intr($11,Regs);
            if ((Al and $30) shr 4) = 3 then
               Temp := Mono
            else
               Temp := CGA;
         end else
         begin
            Ah := $12;
            BX := $10;  {one more time!}
            Intr($10,Regs);
            if Bh = 0 then
               Temp := EGACol
            else
               Temp := EGAMono;
         end;  {if}
      end; {if}
   end; {with}
   TestVideo := Temp;
end; { TestVideo }

function GetDispMode:byte;
{}
var Regs: registers;
begin
   with Regs do
   begin
      Ax := $0F00;
      Intr($10,Regs);  {get video display mode}
      GetDispMode := Al;
   end;
end; { GetDispMode }

function OSVersion(Major:boolean):byte;
{if Major is false the minor version number is returned, e.g. 2 for DOS 3.2}
var Regs:registers;
begin
   with Regs do
   begin
      Ah := $30;
      msdos(Regs);
      if Major then
         OSVersion := Al
      else
         OSVersion := Ah;
   end;
end; { OSVersion }

function OSVersionStr: string;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      with OSData do
         OSVersionStr := IntToStr(vMajor)+'.'+IntToStr(vMinor);
   end;
end; { OSVersionStr }

function ColorScreen:boolean;
{}
begin
   with HardVars do
      ColorScreen := ColorSystem and (HardVars.ForceBW = false);
end; { ColorScreen }

function ComputerID: byte;
{}
var DosData: DosDataRec;
begin
   with HardVars do
   begin
      GetDosData(DosData);
      ComputerID := DosData.vComputerID;
   end;
end; { ComputerID }

function ParallelPorts: byte;
{}
var DosData: DosDataRec;
begin
   with HardVars do
   begin
      GetDOSData(DosData);
      ParallelPorts := hi(DosData.vMainInfo) shr 6;
   end;
end; { ParallelPorts }

function SerialPorts: byte;
{}
var DosData: DosDataRec;
begin
   with HardVars do
   begin
      GetDOSData(DosData);
      SerialPorts := hi(DosData.vMainInfo) and $0F shr 1;
   end;
end; { SerialPorts }

function FloppyDrives: byte;
{}
var DOSData: DosDataRec;
begin
   with HardVars do
   begin
      GetDOSData(DosData);
      FloppyDrives := ((DosData.vMainInfo and $C0) shr 6) + 1;
   end;
end; { FloppyDrives }

function ROMDate: string;
{}
var DosData: DosDataRec;
begin
   with HardVars do
   begin
      GetDOSData(DosData);
      ROMDate := DosData.vROMDate;
   end;
end; { ROMDate }

function GameAdapter: boolean;
{}
var DosData: DosDataRec;
begin
   with HardVars do
   begin
      GetDOSData(DosData);
      GameAdapter := ((DosData.vMainInfo and $1000) = 1);
   end;
end; { GameAdapter }

function SerialPrinter: boolean;
{}
var DosData: DosDataRec;
begin
   with HardVars do
   begin
      GetDOSData(DosData);
      SerialPrinter := ((DosData.vMainInfo and $2000) = 1);
   end;
end; { SerialPrinter }

function MathChip: boolean;
{}
var DosData: DosDataRec;
begin
   with HardVars do
   begin
      GetDOSData(DosData);
      MathChip := ((DosData.vMainInfo and $2) = $2);
   end;
end; { MathChip }

                        {*************************}
                        {**  M E M   S T U F F  **}
                        {*************************}

function BaseMemory: integer;
{}
var MemData: MemDataRec;
begin
   with HardVars do
   begin
      GetMemData(MemData);
      BaseMemory := MemData.vMemInfo;
   end;
end; { BaseMemory }

function EMMInstalled: boolean;
{Expanded memory}
var MemData: MemDataRec;
begin
   with HardVars do
   begin
      GetMemData(MemData);
      EMMInstalled := MemData.vEMMInstalled;
   end;
end; { EMMInstalled }

function XMSInstalled: boolean;
{Extended memory}
var MemData: MemDataRec;
begin
   with HardVars do
   begin
      GetMemData(MemData);
      XMSInstalled := MemData.vXMSInstalled;
   end;
end; { XMSInstalled }

function EMMVersionMajor: byte;
{}
var MemData: MemDataRec;
begin
   with HardVars do
   begin
      GetMemData(MemData);
      EMMVersionMajor := MemData.vEMMMajor;
   end;
end; { EMMVersionMajor }

function EMMVersionMinor: byte;
{}
var MemData: MemDataRec;
begin
   with HardVars do
   begin
      GetMemData(MemData);
      EMMVersionMinor := MemData.vEMMMinor;
   end;
end; { EMMVersionMinor }

function EMMVersion: string;
{}
begin
   EMMVersion := chr(EMMVersionMajor + 48)+'.'+chr(EMMVersionMinor + 48);
end; { EMMVersion }

                        {*************************}
                        {**  O. S.   S T U F F  **}
                        {*************************}

function OSVersionMajor: byte;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      OSVersionMajor := OSData.vMajor;
   end;
end; { OSVersionMajor }

function OSVersionMinor: byte;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      OSVersionMinor := OSData.vMinor;
   end;
end; { OSVersionMinor }

function Country: word;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      Country := OSData.vCountry;
   end;
end; { Country }

function Currency: string;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      Currency := OSData.vCurrency;
   end;
end; { Currency }

function DateFmt: OSDate;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      DateFmt := OSData.vDateFmt;
   end;
end; { DateFmt }

function ThousandsSep: char;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      ThousandsSep := chr(OSData.vThousands);
   end;
end; { ThousandsSep }

function DecimalSep: char;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      DecimalSep := chr(OSData.vDecimal);
   end;
end; { DecimalSep }

function DateSep: char;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      DateSep := chr(OSData.vDateSeparator);
   end;
end; { DateSep }

function TimeSep: char;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      TimeSep := chr(OSData.vTimeSeparator);
   end;
end; { TimeSep }

function TimeFmt: byte;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      TimeFmt := OSData.vTimeFmt;
   end;
end; { TimeFmt }

function CurrencyFmt: byte;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      CurrencyFmt := OSData.vCurrencyFmt;
   end;
end; { CurrencyFmt }

function CurrencyDecPlaces: byte;
{}
var OSData: OSDataRec;
begin
   with HardVars do
   begin
      GetOSData(OSData);
      CurrencyDecPlaces := OSData.vCurrencyDecPlaces;
   end;
end; { CurrencyDecPlaces }

                   {***********************************}
                   {**  H A R D W A R E   S T U F F  **}
                   {***********************************}

procedure ShowRegs;
{ DEVELOPERS NOTE - for trouble shooting only }
var  CurX, CurY: byte;
begin
   with HardVars do
   begin
      CurX := WhereX;
      CurY := WhereY;
      with Regs Do
      begin
         GotoXY(63,1);
         Write('┌──────────────┐');
         GotoXY(63,2);
         Write('│  Registers   │');
         GotoXY(63,3);
         Write('│              │');
         GotoXY(63,4);
         Write('│  AH - $',IntToHEXStr(AH,2):2,'    │');
         GotoXY(63,5);
         Write('│  AL - $',IntToHEXStr(AL,2):2,'    │');
         GotoXY(63,6);
         Write('│  BH - $',IntToHEXStr(BH,2):2,'    │');
         GotoXY(63,7);
         Write('│  BL - $',IntToHEXStr(BL,2):2,'    │');
         GotoXY(63,8);
         Write('│  CH - $',IntToHEXStr(CH,2):2,'    │');
         GotoXY(63,9);
         Write('│  CL - $',IntToHEXStr(CL,2):2,'    │');
         GotoXY(63,10);
         Write('│  DH - $',IntToHEXStr(DH,2):2,'    │');
         GotoXY(63,11);
         Write('│  DL - $',IntToHEXStr(DL,2):2,'    │');
         GotoXY(63,12);
         Write('│  AX - $',IntToHEXStr(AX,4):4,'  │');
         GotoXY(63,13);
         Write('│  BX - $',IntToHEXStr(BX,4):4,'  │');
         GotoXY(63,14);
         Write('│  CX - $',IntToHEXStr(CX,4):4,'  │');
         GotoXY(63,15);
         Write('│  DX - $',IntToHEXStr(DX,4):4,'  │');
         GotoXY(63,16);
         Write('│  BP - $',IntToHEXStr(BP,4):4,'  │');
         GotoXY(63,17);
         Write('│  SI - $',IntToHEXStr(SI,4):4,'  │');
         GotoXY(63,18);
         Write('│  DI - $',IntToHEXStr(DI,4):4,'  │');
         GotoXY(63,19);
         Write('│  DS - $',IntToHEXStr(DS,4):4,'  │');
         GotoXY(63,20);
         Write('│  ES - $',IntToHEXStr(ES,4):4,'  │');
         GotoXY(63,21);
         Write('│              │');
         GotoXY(63,22);
         Write('└──────────────┘');
      end;
      GotoXY(CurX,CurY);
   end;
end;  { ShowRegs }

function LastDrv: integer;
{}
var Regs: registers;
begin
   with Regs do
   begin
      AH := $0E;
      DL := pred(CurrentDriveByte);
      MsDos(Regs);
      LastDrv := AL;
   end;
end; { LastDrv }

function LogicalDriveNum( Drive: char ): byte;
{converts drive letter to logical drive byte}
begin
   Drive := upCase(Drive);
   if ( Drive in ['A'..'Z'] ) then
      LogicalDriveNum := (ord(Drive) - 65)
   else
      LogicalDriveNum := 0;
end; { LogicalDriveNum }

function PhysicalDriveNum( Drive: char ): byte;
{converts drive letter to physical drive byte}
begin
   Drive := upcase(Drive);
   if ( Drive in ['A'..'Z'] ) then
      PhysicalDriveNum := (ord(Drive) - 64)
   else
     PhysicalDriveNum := 0;
end; { PhysicalDriveNum }

function DriveChar( Drive: byte ): char;
{converts drive byte to drive char}
begin
  if ( Drive in [1..26] ) then
     DriveChar := chr(Drive + 64)
  else
     DriveChar := CurrentDriveChar;
end; { DriveChar }

function GetMediaSerialNumber( Drive: byte ): string;
{}
var Answer: string[4];
    X: integer;
    HWData: HardWareRec;
begin
   with HardVars do
   begin
      GetHWData(HWData);
      with Regs Do
      begin
         AH := $69;
         AL := $00;
         BL := Drive;
         DS := Seg(HWData.MediaPointer^);
         DX := Ofs(HWData.MediaPointer^);
         Intr($21,Regs);
         if ( Flags AND Fcarry ) = 0 then
         begin
            Move(HWData.MediaPointer^.SerialNumber,Answer[1],4);
            Answer[0] := #4;
            GetMediaSerialNumber :=
               concat(IntToHexStr(ord(Answer[4]),2),
                      IntToHexStr(ord(Answer[3]),2),'-',
                      IntToHexStr(ord(Answer[2]),2),
                      IntToHexStr(ord(Answer[1]),2));
         end else
            GetMediaSerialNumber := '';
      end;
   end;
end; { GetMediaSerialNumber }

function SetMediaSerialNumber( Drive: byte; Serial: longint ): boolean;
{}
var HWData: HardWareRec;
begin
   with HardVars do
   begin
      SetMediaSerialNumber := false;
      GetHWData(HWData);
      HWData.MediaPointer^.SerialNumber := Serial;
      with Regs Do
      begin
         AH := $69;
         AL := $01;
         BL := Drive;
         DS := Seg(HWData.MediaPointer^);
         DX := Ofs(HWData.MediaPointer^);
         Intr($21,Regs);
         SetMediaSerialNumber := (( Flags AND Fcarry ) = 0)
      end;
   end;
end; { SetMediaSerialNumber }

function MediaIsLabeled( Drive: byte ): boolean;
{}
var SrchRec: SearchRec;
begin
   MediaIsLabeled := false;
   FindFirst(DriveChar(Drive) + ':\*.*',VolumeID,SrchRec);
   MediaIsLabeled := (DosError = 0);
end; { MediaIsLabeled }

function DeleteVolumeLabel( Drive: byte ): byte;
{}
var HWData: HardWareRec;
begin
   with HardVars do
   begin
      DeleteVolumeLabel := $FF;
      if MediaIsLabeled(Drive) then
      begin
         GetHWData(HWData);
         with HWData.vExFCB Do
         begin
            FF := $FF;
            Attribute := VolumeID;
            DriveID := Drive;  { A = 1, B = 2, ... }
            Fillchar(Filename,8,'?');
            Fillchar(Extension,3,'?');
         end;
         with Regs Do
         begin
            AH := $13;          { Delete file FCB }
            DS := Seg(HWData.vExFCB);
            DX := Ofs(HWData.vExFCB);
            Intr($21,Regs);
            DeleteVolumeLabel := AL;
         end;
      end;
   end;
end; { DeleteVolumeLabel }

function SetVolumeLabel( Drive: byte; LabelStr: Str12 ): byte;
{}
var I: Integer;
    HWData: HardWareRec;
begin
   with HardVars do
   begin
      SetVolumeLabel := $FF;
      if MediaIsLabeled(Drive) and (DeleteVolumeLabel(Drive) = 0 ) then
      begin
         if Pos('.',LabelStr) <> 0 then
            Delete(LabelStr,Pos('.',LabelStr),1);
         While Length(LabelStr) <> 11 Do
         LabelStr := LabelStr + ' ';
         GetHWData(HWData);
         with HWData.vExFCB Do
         begin
            FF := $FF;
            Attribute := VolumeID;
            DriveID := Drive;
            Fillchar(Filename,8,#0);
            Fillchar(Extension,3,#0);
            For I := 1 to 8 Do
            Filename[I] := UpCase(LabelStr[I]);
            For I := 9 to 11 Do
            Extension[ I - 8 ] := UpCase(LabelStr[I]);
         end;
         with Regs Do
         begin
            AH := $16;   { Create File FCB }
            DS := Seg(HWData.vExFCB);
            DX := Ofs(HWData.vExFCB);
            Intr($21,Regs);
            with Regs Do
            begin
               AH := $10;         { Closes an open FCB }
               DS := Seg(HWData.vExFCB);
               DX := Ofs(HWData.vExFCB);
               Intr($21,Regs);
               SetVolumeLabel := AL;
            end;
         end;
      end;
   end;
end; { SetVolumeLabel }

function GetVolumeLabel( Drive: byte ): string;
{}
var SrchRec: SearchRec;
begin
   SrchRec.Name := '';
   GetVolumeLabel := '';
   FindFirst(DriveChar(Drive) + ':\*.*',VolumeID,SrchRec);
   if DosError = 0 then
      GetVolumeLabel := Strip('A','.',SrchRec.Name)
end; { GetVolumeLabel }

function LabelIsCorrect( Drive: byte; LabelName: string ): LabelStatus;
{}
var TempLabel: Str12;
begin
   if MediaIsLabeled(Drive) AND ( Length(LabelName) > 0 ) then
   begin
      LabelIsCorrect := IncorrectLabel;
      TempLabel := GetVolumeLabel( Drive );
      LabelName := Strip('A','.',LabelName);
      if ( TempLabel = SetUpper( LabelName )) then
         LabelIsCorrect := CorrectLabel;
   end else
      LabelIsCorrect := NoLabel;
end; { LabelIsCorrect }

function IsPhantom: boolean;
{}
begin
   with HardVars do
   begin
      IsPhantom := false;
      Intr($11,Regs);
      IsPhantom := (( Regs.AX AND $00C0 ) = 0 );
      { Could probably read: IsPhantom := (FloppyDrives = 1); }
   end;
end;

function DriveExists(Drive: Char): boolean;
{}
var
  Regs:registers;
  StartDrive: byte;
begin
   drive := upcase(Drive);
   if not (ord(drive) in  [65..90]) then
      DriveExists := false
   else
   with Regs do
   begin
      StartDrive := CurrentDriveByte;
      Ah := $0E;           {select the drive to be tested}
      Dl := ord(drive) - 65;
      intr($21,Regs);
      Ah := $19;           {get the current drive again}
      intr($21,Regs);
      DriveExists :=  Al = ord(drive) - 65;
      if PhysicalDriveNum(drive) = 2 then
         DriveExists := not IsPhantom;
      SetCurrentDriveTo(DriveChar(StartDrive));
   end;
end; { DriveExists }

function DriveIsReady( Drive: byte ): boolean;
{}
begin
   with HardVars do
   begin
      DriveIsReady := false;
      if ( FloppyDrives = 1 ) then
         SetDriveTo(Drive);
      with Regs Do
      begin
         AH := $32;    { Get DOS drive parameter block }
         DL := Drive;    { $00=default, $01=A, $02=B ... }
         Intr($21,Regs);
         DriveIsReady := (AL = 0);
      end;
   end;
end; { DriveIsReady }

procedure SetDriveTo( Drive: byte );
{ Eliminates "Insert diskette in drive" message }
begin
   with HardVars do
   begin
      if FloppyDrives = 1 then
      case Drive of
         1: Mem[$0000:$0504] := 00;
         2: Mem[$0000:$0504] := 01;
      end;
   end;
end; { SetDriveTo }

function CurrentDriveByte: byte;
{}
var Regs: registers;
begin
   with Regs do
   begin
      AH := $19;    { Get Default Drive }
      Intr($21,Regs);
      CurrentDriveByte := AL + 1;
   end;
end; { CurrentDriveByte }

function CurrentDriveChar: char;
{returns the character of the current drive}
begin
   CurrentDriveChar := chr(CurrentDriveByte + 64);
end; { CurrentDriveChar }

procedure SetCurrentDriveTo( NewDrive: char );
{}
begin
   with HardVars do
   begin
      if ( Ord(Upcase(NewDrive)) - 64 ) <= FloppyDrives then
      Fillchar(Regs,SizeOf(Regs),#0);
      with Regs Do
      begin
         AH := $0E;    { Select Disk }
         DL := Ord(NewDrive) - 65;
         Intr($21,Regs);
      end;
   end;
end; { SetCurrentDriveTo }

function CurrentPathStr: DirStr;
{returns the current path string.
 this excludes the final backslash}
var TempStr: dirstr;
begin
   GetDir(0,TempStr);
   CurrentPathStr := TempStr;
end; { CurrentPathStr }

function SetCurrentPath( NewPath: PathStr ): boolean;
{}
begin
   if NewPath[length(NewPath)] = '\' then
      delete(NewPath,length(NewPath),1);
   {$I-} ChDir(NewPath); {$I+}
   SetCurrentPath  := (IOResult = 0);
end; { SetCurrentPath }

function ValidPath( Path: PathStr ): boolean;
{}
var PathLen,
    gResult: Integer;
    FN: file;
begin
   PathLen := Length( Path );
   if ( Path[PathLen] = '\' ) AND
      ( Path[Pred(PathLen)] <> ':' ) then
      Delete(Path,PathLen,1);
   assign(FN,Path+'\nul');
   {$I-} reset(FN); {$I+}
   ValidPath := (IOResult = 0)
end; { ValidPath }

              {**********************************************}
              {**  U N I T    I N I T I A L I Z A T I O N  **}
              {**********************************************}

procedure HardDefaultSettings;
{}
begin
   with HardVars do
   begin
      ForceBW := false;
      AnimateDelay := 100;
   end;
end; { HardDefaultSettings }

procedure GoldHardInit;
{internal}
var DM:integer;
begin
   HardDefaultSettings;
   with HardVars do
   begin
      ECode := 0;
      DisplayType := TestVideo;
      DM := GetDispMode;
   {$IFDEF DPMI}
      if DM = 7 then
         ScreenPtr := ptr(segB000,0) {Mono}
      else
         ScreenPtr := ptr(segB800,0); {Color}
   {$ELSE}
      if DM = 7 then
         ScreenPtr := ptr($B000,0) {Mono}
      else
         ScreenPtr := ptr($B800,0); {Color}
   {$ENDIF}
   {$IFDEF FORCEMONO}  {for debugging colors on dual monitors}
         ScreenPtr := ptr(segB000,0); {Color}
   {$ENDIF}
      ColorSystem := DM <> 7;
      Width := 80;
      Depth := succ(Hi(WindMax));
   end;
end; { GoldHardInit }

begin
   GoldHardInit;
end.